home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbs_utl.zip / MAKEFIDX.BAS < prev    next >
BASIC Source File  |  1990-11-20  |  13KB  |  386 lines
  1. DECLARE SUB TRIM (TRIM.PARM$)
  2. DECLARE SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING%)
  3. DECLARE SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$)
  4. DECLARE SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND%, NUM.FINDS%)
  5. DEFINT A-Z
  6. DIM FileSpec$(999)
  7. DIM FileDir$(255)
  8. DIM LocationIndex$(999)
  9. TRUE = -1
  10. FALSE = 0
  11. WriteMode$ = "REPLACE"
  12. NameFile$ = "FIDX.DEF"
  13. LocationFile$ = "LIDX.DEF"
  14. DirString$ = "DIRECTORY OF"                                          ' 0216
  15. SHARING = FALSE
  16. NumLocations = 0
  17. NumFileSpecs = 0
  18. NumFileDirs = 0
  19. StartCol = 1                                                         ' 0224
  20. ConfigFile$ = "MAKEFIDX.CFG"
  21. PassedArguments$ = COMMAND$
  22. PassedArguments$ = UCASE$(PassedArguments$) 
  23. X = INSTR(PassedArguments$,"/B")
  24. RunBatch = (X > 0)
  25. IF RunBatch THEN 
  26.    PassedArguments$ = LEFT$(PassedArguments$, X-1) + RIGHT$(PassedArguments$,Len(PassedArguments$)-X-1)
  27. END IF
  28. IF PassedArguments$ <> "" THEN
  29.    ConfigFile$ = PassedArguments$
  30. END IF
  31.  
  32. ON ERROR GOTO 40000
  33. IF SHARING THEN
  34.    OPEN ConfigFile$ FOR INPUT SHARED AS #1
  35. ELSE
  36.    OPEN ConfigFile$ FOR INPUT AS #1
  37. END IF
  38. ON ERROR GOTO 0
  39. WHILE NOT EOF(1)
  40.    LINE INPUT #1, A$
  41.    X$ = LEFT$(A$, 1)
  42.    IF X$ <> "" AND X$ <> "*" THEN
  43.       A$ = UCASE$(A$) 
  44.       IF LEFT$(A$,11) = "/WRITEMODE=" THEN
  45.          WriteMode$ = MID$(A$,12)
  46.          CALL TRIM (WriteMode$)
  47.       END IF
  48.       IF LEFT$(A$, 10) = "/NAMEFILE=" THEN
  49.          NameFile$ = MID$(A$, 11)
  50.          CALL TRIM(NameFile$)
  51.       END IF
  52.       IF LEFT$(A$, 14) = "/LOCATIONFILE=" THEN
  53.          LocationFile$ = MID$(A$, 15)
  54.          CALL TRIM(LocationFile$)
  55.       END IF
  56.       IF LEFT$(A$, 10) = "/FILESPEC=" THEN
  57.          X$ = MID$(A$, 11)
  58.          CALL TRIM(X$)
  59.          NumFileSpecs = NumFileSpecs + 1
  60.          FileSpec$(NumFileSpecs) = X$
  61.       END IF
  62.       IF LEFT$(A$, 9) = "/FILEDIR=" THEN
  63.          X$ = MID$(A$, 10)
  64.          CALL TRIM(X$)
  65.          NumFileDirs = NumFileDirs + 1
  66.          FileDir$(NumFileDirs) = X$
  67.       END IF
  68.       IF LEFT$(A$,11) = "/DIRSTRING=" THEN                           ' 0216
  69.          X$ = MID$(A$,12)                                            ' 0216
  70.          CALL TRIM (X$)                                              ' 0216
  71.          DirString$ = X$                                             ' 0216
  72.          DirString$ = UCASE$(DirString$)                             ' 0220
  73.       END IF                                                         ' 0216
  74.    END IF
  75. WEND
  76. CLOSE 1
  77.  
  78. Replacing = (LEFT$(WriteMode$, 1) = "R")
  79.  
  80. PRINT "MAKEFIDX version 1.2 Nov 20, 1990 copyright (c) 1990 by Ken Goosens"
  81. PRINT "an RBBS utility to make files for fast directory searches"
  82. PRINT
  83. PRINT "On this run"
  84. IF Replacing THEN
  85.    PRINT "Overwriting data files"
  86. ELSE
  87.    PRINT "Adding to data files"
  88. END IF
  89. PRINT "Configuration file used ....... ";ConfigFile$
  90. PRINT "Name of list of files ......... "; NameFile$
  91. PRINT "Name of list of locations ..... "; LocationFile$
  92. PRINT "# of DOS directories to process"; NumFileSpecs
  93. PRINT "# of file lists to process ...."; NumFileDirs
  94. PRINT
  95. IF NOT RunBatch THEN
  96.    INPUT "A to abort, anything else runs"; ANS$
  97.    ANS$ = UCASE$(ANS$)
  98.    IF ANS$ = "A" THEN END
  99. END IF
  100.  
  101. 'NumFileSpecs = 2
  102. 'FileSpec$(1) = "C:\TEMP\"
  103. 'FileSpec$(2) = "C:\UTILS\"
  104. IF Replacing THEN
  105.    ON ERROR GOTO 40100
  106.    KILL NameFile$
  107.    KILL LocationFile$
  108.    ON ERROR GOTO 0
  109. ELSE
  110.    IF SHARING THEN
  111.       OPEN LocationFile$ FOR INPUT SHARED AS #1
  112.    ELSE
  113.       OPEN LocationFile$ FOR INPUT AS #1
  114.    END IF
  115.    PRINT "Loading existing locations..."
  116.    WHILE NOT EOF(1)
  117.       LINE INPUT #1, A$
  118.       CALL TRIM(A$)
  119.       NumLocations = NumLocations + 1
  120.       LocationIndex$(NumLocations) = A$
  121.    WEND
  122.    CLOSE 1
  123.    PRINT STR$(NumLocations); " locations loaded"
  124. END IF
  125.  
  126. IF SHARING THEN
  127.    OPEN NameFile$ FOR RANDOM SHARED AS #2 LEN = 18
  128.    OPEN LocationFile$ FOR RANDOM SHARED AS #3 LEN = 66
  129. ELSE
  130.    OPEN NameFile$ FOR RANDOM AS #2 LEN = 18
  131.    OPEN LocationFile$ FOR RANDOM AS #3 LEN = 66
  132. END IF
  133. FIELD 2, 18 AS NameRec$
  134. FIELD 3, 66 AS LocationRec$
  135. MID$(NameRec$, 17, 2) = CHR$(13) + CHR$(10)
  136. MID$(LocationRec$, 64, 3) = "." + CHR$(13) + CHR$(10)
  137. NumRecsNameFile = LOF(2) / 18
  138. NumRecsLocationFile = LOF(3) / 66
  139.  
  140. InFile$ = "IDX.$$$"
  141. FOR ix = 1 TO NumFileSpecs
  142.    PRINT "Processing filespec "; FileSpec$(ix) ;                     ' 112090
  143. '  SHELL "DIR " + FileSpec$(ix) + " > IDX.$$$"
  144. '  GOSUB ProcessFile
  145.    GOSUB ProcessDir                                                  ' 112090
  146. NEXT
  147.  
  148. FOR ix = 1 TO NumFileDirs
  149.    InFile$ = FileDir$(ix)
  150.    PRINT "Processing file list "; FileDir$(ix) ;                     ' 112090
  151.    GOSUB ProcessFile
  152. NEXT
  153.  
  154. END
  155.  
  156. ProcessDir:                                                          ' 112090
  157.  
  158.    CALL BRKFNAME (FileSpec$(ix),CurrentDrivePath$,Prefix$,Extension$,TRUE)
  159.    CALL FindFirstF(FileSpec$(ix)+CHR$(0),0,RtnCode)
  160.    IF RtnCode <> 0 THEN
  161.       PRINT
  162.       PRINT "   No files found"
  163.       RETURN
  164.    END IF
  165.    GOSUB SetLocIndex
  166.    RecCt = 0
  167.    PrtCol = POS(0) + 1                                               ' 112090
  168.    WHILE RtnCode = 0
  169.       RecCt = RecCt + 1                                              ' 112090
  170.       LOCATE ,PrtCol                                                 ' 112090
  171.       PRINT RecCt ;                                                  ' 112090
  172.       FileName$ = SPACE$(12)
  173.       CALL GetNameF (FileName$,FLen)
  174.       FileName$ = LEFT$(FileName$,FLen)
  175.       GOSUB AddFileName
  176.       CALL FindNextF (RtnCode)
  177.    WEND
  178.  
  179.    PRINT
  180.  
  181. RETURN
  182.  
  183. ProcessFile:
  184.  
  185.    ON ERROR GOTO 40200                                               ' 111990
  186.    IF SHARING THEN
  187.       OPEN InFile$ FOR INPUT SHARED AS #1
  188.    ELSE
  189.       OPEN InFile$ FOR INPUT AS #1
  190.    END IF
  191.    ON ERROR GOTO 0                                                   ' 111990
  192.    RecCt = 0                                                         ' 112090
  193.    PrtCol = POS(0) + 1                                               ' 112090
  194.    WHILE NOT EOF(1)
  195.       LINE INPUT #1, A$
  196.       RecCt = RecCt + 1                                              ' 112090
  197.       LOCATE ,PrtCol                                                 ' 112090
  198.       PRINT RecCt ;                                                  ' 112090
  199.       X$ = UCASE$(A$)
  200.       X = INSTR(X$, DirString$)                                      ' 0216
  201.       IF X > 0 THEN                                                  ' 0224
  202.          IF LEFT$(X$,X-1) = SPACE$(X-1) THEN                         ' 0224
  203.             DrivePath$ = MID$(A$, X + LEN(DirString$))               ' 0216
  204.             CALL TRIM(DrivePath$)
  205.             IF LEFT$(DrivePath$,3) <> "M! " THEN                     ' 0217
  206.                IF INSTR(DrivePath$,"*") > 0 OR INSTR(DrivePath$,"?") > 0 THEN  ' 0216
  207.                   CALL BRKFNAME (DrivePath$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0216
  208.                   DrivePath$ = RtnDrivePath$                         ' 0216
  209.                END IF
  210.                IF INSTR(DrivePath$, "\") > 0 THEN
  211.                   IF RIGHT$(DrivePath$, 1) <> "\" THEN
  212.                      DrivePath$ = DrivePath$ + "\"
  213.                   END IF
  214.                END IF
  215.             END IF                                                   ' 0217
  216.             CurrentDrivePath$ = DrivePath$
  217.             GOSUB SetLocIndex
  218.             GOTO DoneEntry
  219.          END IF                                                      ' 0224
  220.       END IF
  221.       IF INSTR(" .", LEFT$(A$, 1)) > 0 THEN
  222.          GOTO DoneEntry
  223.       END IF
  224.       IF LEN(A$) < StartCol THEN                                     ' 0224
  225.          GOTO DoneEntry                                              ' 0224
  226.       END IF                                                         ' 0224
  227.       IF StartCol > 1 THEN                                           ' 0224
  228.          A$ = MID$(A$,StartCol)                                      ' 0224
  229.       END IF                                                         ' 0224
  230.       X = INSTR(A$, " ")
  231.       IF X = 0 THEN                                                  ' 0217
  232.          X = LEN(A$) + 1                                             ' 0217
  233.       ELSE
  234.          IF X < 13 THEN
  235.             FileName$ = LEFT$(A$, 12)
  236.             IF INSTR(FileName$, ".") = 0 AND MID$(FileName$, 9, 1) = " " AND MID$(FileName$, 10, 1) <> " " THEN
  237.                MID$(FileName$, X) = "." + MID$(FileName$, 10) + SPACE$(9 - X)
  238.             ELSE
  239.                FileName$ = LEFT$(A$, X - 1)
  240.             END IF
  241.             GOSUB AddFileName
  242.             GOTO DoneEntry
  243.          END IF
  244.       END IF                                                         ' 0217
  245.       FileName$ = LEFT$(A$, X - 1)
  246.       CALL BRKFNAME (FileName$,RtnDrivePath$,RtnPrefix$,RtnExt$,TRUE) ' 0217
  247.       IF RtnDrivePath$ <> "" THEN                                    ' 0217
  248.          DrivePath$ = RtnDrivePath$                                  ' 0217
  249.          FileName$ = RtnPrefix$ + RtnExt$                            ' 0217
  250.       END IF                                                         ' 0217
  251.       GOSUB AddFileName
  252. DoneEntry:
  253.    WEND
  254. QuitEntry:                                                           ' 111990
  255.    ON ERROR GOTO 0                                                   ' 111990
  256.    CLOSE 1
  257.    PRINT                                                             ' 111990
  258. RETURN
  259.  
  260. SetPathName:
  261.  
  262.    CALL BRKFNAME(FileName$, FileDrivePath$, FilePrefix$, FileExt$, TRUE)
  263.    IF FileDrivePath$ <> "" THEN
  264.       CurrentDrivePath$ = FileDrivePath$
  265.       GOSUB SetLocIndex
  266.       FileName$ = FilePrefix$ + FileExt$
  267.    ELSE
  268.       CurrentDrivePath$ = DrivePath$
  269.    END IF
  270.  
  271. RETURN
  272.  
  273. AddFileName:
  274.  
  275.    GOSUB SetPathName
  276.    MID$(NameRec$, 1, 16) = SPACE$(16)
  277.    MID$(NameRec$, 1, 12) = FileName$
  278.    X$ = MID$(STR$(Location), 2)
  279.    X$ = SPACE$(4 - LEN(X$)) + X$
  280.    MID$(NameRec$, 13, 4) = X$
  281.    NumRecsNameFile = NumRecsNameFile + 1
  282.    PUT 2, NumRecsNameFile
  283.  
  284. RETURN
  285.  
  286. SetLocIndex:
  287.  
  288.    IF CurrentDrivePath$ = LocationIndex$(Location) THEN RETURN
  289.    LocationIndex$(NumRecsLocationFile + 1) = CurrentDrivePath$
  290.    Location = 1
  291.    WHILE CurrentDrivePath$ <> LocationIndex$(Location)
  292.       Location = Location + 1
  293.    WEND
  294.    IF Location > NumRecsLocationFile THEN
  295.       NumRecsLocationFile = Location
  296.       MID$(LocationRec$, 1, 63) = SPACE$(63)
  297.       MID$(LocationRec$, 1, 63) = CurrentDrivePath$
  298.       PUT 3, NumRecsLocationFile
  299.    END IF
  300.  
  301. RETURN
  302.  
  303. 40000 PRINT "Missing configuration file "; ConfigFile$
  304.       END
  305.  
  306. 40100 RESUME NEXT
  307. 40200 PRINT:PRINT "   ";InFile$;" not found.  Skipping";             ' 111990
  308.       RESUME QuitEntry                                               ' 111990
  309.  
  310.       SUB BRKFNAME (FileName$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING) STATIC
  311.       FileName$ = UCASE$(FileName$)
  312.       DRVPATH$ = ""
  313.       PREFIX$ = ""
  314.       EXTENSION$ = ""
  315.       CALL TRIMTRAIL(FileName$, "\")
  316.       L = LEN(FileName$)
  317.       IF L < 1 THEN EXIT SUB
  318.       CALL FINDLAST(FileName$, "\", X, Y)
  319.       IF X < 1 THEN
  320.          IF MID$(FileName$, 2, 1) = ":" THEN
  321.             DRVPATH$ = LEFT$(FileName$, 1)
  322.             S = 3
  323.          ELSE
  324.             S = 1
  325.          END IF
  326.       ELSE
  327.          DRVPATH$ = LEFT$(FileName$, X - 1)
  328.          S = X + 1
  329.          IF Y = 1 THEN
  330.             DRVPATH$ =  DRVPATH$ + "\"
  331.          END IF
  332.       END IF
  333.       X = INSTR(FileName$ + ".", ".")
  334.       IF X < L THEN
  335.          EXTENSION$ = MID$(FileName$, X + 1, 3)
  336.       END IF
  337.       IF S <= L THEN
  338.          IF X >= S THEN
  339.             PREFIX$ = MID$(FileName$, S, X - S)
  340.          END IF
  341.       END IF
  342.       IF NOT FOR.JOINING THEN EXIT SUB
  343.       IF LEN(DRVPATH$) = 1 THEN
  344.          IF DRVPATH$ <> "\" THEN
  345.             DRVPATH$ = DRVPATH$ + ":"
  346.          END IF
  347.       END IF
  348.       IF INSTR(DRVPATH$, "\") > 0 AND RIGHT$(DRVPATH$, 1) <> "\" THEN DRVPATH$ = DRVPATH$ + "\"
  349.       IF LEN(EXTENSION$) > 0 THEN EXTENSION$ = "." + EXTENSION$
  350.       END SUB
  351.  
  352.       SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND, NUM.FINDS) STATIC
  353.       WHERE.FOUND = INSTR(LOOK.IN$, LOOK.FOR$)
  354.       NUM.FINDS = -(WHERE.FOUND > 0)
  355.       NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
  356.       WHILE NEXT.FOUND > 0
  357.          NUM.FINDS = NUM.FINDS + 1
  358.          WHERE.FOUND = NEXT.FOUND
  359.          NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
  360.       WEND
  361.       END SUB
  362.  
  363.       SUB TRIM (TRIM.PARM$) STATIC
  364.       L = INSTR(TRIM.PARM$, " ")
  365.       IF L < 1 THEN EXIT SUB
  366.       IF L = 1 THEN
  367.          WHILE LEFT$(TRIM.PARM$, 1) = " "
  368.             TRIM.PARM$ = RIGHT$(TRIM.PARM$, LEN(TRIM.PARM$) - 1)
  369.          WEND
  370.       END IF
  371.       CALL TRIMTRAIL(TRIM.PARM$, " ")
  372.       END SUB
  373.  
  374.       SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$) STATIC
  375.       IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN EXIT SUB
  376.       J = LEN(TRIM.PARM$) - 1
  377. 108   IF J > 0 THEN
  378.          IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN
  379.             J = J - 1
  380.             GOTO 108
  381.          END IF
  382.       END IF
  383.       TRIM.PARM$ = LEFT$(TRIM.PARM$, J)
  384.       END SUB
  385.  
  386.